# Usage: angle.tcl file.ps file.map

package require Iexpect

source "expand.tcl"

proc getCore {province} {
	if {[set slash [string last "/" $province]] == -1} {return $province}
	return [string range $province 0 [expr $slash - 1]]
}

proc extractCore {province coreName}  {
	upvar $coreName core
	if {[set slash [string last "/" $province]] == -1} {return 0}
	set core [string range $province 0 [expr $slash - 1]]
	return 1
}

proc lappendOnce {listName args} {
	upvar $listName list
	if {![info exists list]} {set list ""} 
	foreach arg $args {
		if {[lsearch $list $arg] == -1} {
			lappend list $arg
		}
	}
}

set radToDeg [expr 45./atan(1)]

proc getAngle {from via to} {
	global coordinates radToDeg

	foreach {x0 y0} $coordinates($via) {}
	foreach {x1 y1} $coordinates($from) {}
	foreach {x2 y2} $coordinates($to) {}
	expr $radToDeg * atan2(abs(-($x2-$x0)*($y1-$y0)+($x1-$x0)*($y2-$y0)),abs(($x1-$x0)*($x2-$x0)+($y1-$y0)*($y2-$y0)))
}

# Check arguments.

if {[llength $argv] < 2} {
	puts "Error: 2 arguments required, the names of a variant .ps file and corresponding .map file."
	puts "Usage: angle.tcl variant.ps variant.map"
	exit
}

# Parsing the .ps file

iexpect::Expect I -file [lindex $argv 0] -white

if {![I expect fill "% INFO ?\n"]} {
	puts "Error: \"% INFO\" not found in [lindex $argv 0]"
	exit
}

array set coordinates ""
I expect line "^% (\[-+.0-9\]+) (\[-+.0-9\]+) (\[^ \]+) " {
	set coordinates([string toupper [I get match 3]]) "[I get match 1] [I get match 2]"
	I continue
} "^% MAP$" {
} default {
	puts "Warning: Can't interpret \"[I get output]\""
	I continue
}

itcl::delete object I

MapExpect I -file [lindex $argv 1]

array set adjacencies ""
array set coasts ""
I expect line -nocase "^(\[^ \]+) (\[^ \]+) abuts " {
	set province [string toupper [I get match 2]]
	if {![info exists coordinates($province)]} {
		puts "Warning: No coordinates known for province \"$province\""
		I continue
		return
	}
	if {[extractCore $province core]} {
		set isCoast 0
		lappend coasts($core) $province
	} else {
		set isCoast [string equal "COAST" [string toupper [I get match 1]]]
	}
	foreach adjacency [string toupper [I get unchecked]] {
		# A "*" at the head or tail indicates an adjacency implementing the Cape of Good Hope rules from the 1900 variant.
		# A "~" at the head or tail indicates an adjacency implementing the strait crossing rules from the Loeb9 variant.
		# A second province without round brackets at the end indicates control of the SC in that province is needed to be able to travel through.
		regexp "\[*~\]?(\[^*~(\]+)\[*~\]?" $adjacency dummy adjacency
		if {![info exists coordinates($adjacency)]} {
			puts "Warning: No coordinates known for adjacency \"$adjacency\""
			continue
		}
		lappendOnce adjacencies($province) $adjacency
		if {$isCoast && [extractCore $adjacency core]} {
			lappendOnce adjacencies($province) $core
		}
	}
	I continue
} default {
	I continue
}

itcl::delete object I

if {[llength $argv] <= 2} {
	set minAngle 0
	set maxAngle 90
} elseif {[llength $argv] == 3} {
	set minAngle 0
	set maxAngle [lindex $argv 2]
} else {
	set minAngle [lindex $argv 2]
	set maxAngle [lindex $argv 3]
}

set angles ""
foreach {province neighbors} [array get adjacencies] {
	# Match every neighbor with every other neighbor once to list all combinations of units that can support other units into the province.
	set remainder $neighbors
	foreach neighbor [lrange $neighbors 0 end-1] {
		set neighborCore [getCore $neighbor]
		foreach adjacency [set remainder [lrange $remainder 1 end]] {
			# Avoid situations where the same province borders different sections of a multicoast.
			if {![string equal $neighborCore [getCore $adjacency]]} {
				 set angle [getAngle $neighbor $province $adjacency]
				if {($angle >= $minAngle) && ($angle <= $maxAngle)} {
					lappend angles "$neighbor-$province-$adjacency $angle"
				}
			}
		}
	}

	# In case of a multicoast province, every neighbor province can support any move to any part of the province.	
	set moreNeighbors $neighbors
	if [extractCore $province core] {
		if [info exists adjacencies($core)] {
			eval lappendOnce moreNeighbors $adjacencies($core)
		}
		foreach coast $coasts($core) {
			if {![string equal $coast $province]} {
				eval lappendOnce moreNeighbors $adjacencies($coast)
			}
		}
	} elseif [info exists coasts($province)] {
		foreach coast $coasts($province) {
			eval lappendOnce moreNeighbors $adjacencies($coast)
		}
	} else {
		continue
	}
	set moreNeighbors [lrange $moreNeighbors [llength $neighbors] end]		

	foreach neighbor $moreNeighbors {
		set neighborCore [getCore $neighbor]
		foreach adjacency $neighbors {
			# Avoid situations where the same province borders different sections of a multicoast.
			if {![string equal $neighborCore [getCore $adjacency]]} {
				set angle [getAngle $neighbor $province $adjacency]
				if {($angle >= $minAngle) && ($angle <= $maxAngle)} {
					# Insert a "+" to indicate that this connection is not reciprocal, i.e. only the neighbor can support the adjacency to the province, not vice versa.
					lappend angles "$neighbor+$province-$adjacency $angle"
				}
			}
		}
	}
}

foreach combination [lsort -real -index 1 $angles] {
	puts [eval {format "%s\t%.2f"} $combination]
}

puts "Number of combinations between $minAngle deg and $maxAngle deg: [llength $angles]"
